home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok13 / rows / rowdemo.mod < prev    next >
Text File  |  1993-11-04  |  5KB  |  174 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    RowDemo.mod
  4.     :Contents.   Test module for Rows
  5.     :Author.     Nicolas Benezan [bne]
  6.     :Support.    HeapSort adapted from "Programmierung in Modula-2",
  7.     :Support.    Dal Cin/Lutz/Risse, Teubner Studienskripten
  8.     :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
  9.     :Phone.      711/333679
  10.     :Copyright.  Public Domain
  11.     :Language.   Modula-2
  12.     :Translator. M2Amiga AMSoft V3.2d
  13.     :Imports.    MemSystem1.1 [bne]
  14.     :History.    V1.0d [bne] 28.Jan.1989
  15.     :Bugs.       doesn't test CompSize,Assign,Export,Import
  16.     :Bugs.       HeapSort: element[0] is not sorted
  17.  
  18. **********************************************************************)
  19.  
  20. MODULE RowDemo;
  21.  
  22. FROM Rows       IMPORT Row,Dim,Discard,Read,Write,High,CompSize,
  23.                 RowsAllocProc,RowsDeallocProc;
  24. FROM MemSystem  IMPORT Allocate,Deallocate;
  25. FROM InOut      IMPORT WriteCard,WriteString,WriteLn;
  26. FROM RandomNumber IMPORT RND,PutSeed;
  27. FROM SYSTEM     IMPORT ADR;
  28. FROM Arts       IMPORT Assert;
  29. FROM Dos        IMPORT DateStamp,Date;
  30.  
  31. TYPE    ComponentType=CARDINAL;
  32. CONST   CharsPerColumn=5;
  33.         ColumnsPerLine=70 DIV CharsPerColumn;
  34. VAR     row:Row;
  35.         numbers,Pass:CARDINAL;
  36.         date:Date;
  37.  
  38. PROCEDURE InitMemSystem;
  39. BEGIN
  40.   RowsAllocProc:=Allocate;
  41.   RowsDeallocProc:=Deallocate;
  42. END InitMemSystem;
  43.  
  44. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  45. (* Fill the Row with random numbers                                     *)
  46. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  47. PROCEDURE FillRow(row:Row);
  48. VAR     Count,Random:CARDINAL;
  49. BEGIN
  50.   FOR Count:=0 TO High(row) DO
  51.     Random:=RND(10000);
  52.     Write(row,Count,Random);
  53.   END;
  54. END FillRow;
  55.  
  56. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  57. (* Write one element                                                    *)
  58. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  59. PROCEDURE WriteElement(element:ComponentType);
  60. BEGIN
  61.   WriteCard(element,CharsPerColumn);
  62. END WriteElement;
  63.  
  64. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  65. (* Write the whole Row                                                  *)
  66. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  67. PROCEDURE WriteRow(row:Row);
  68. VAR     Count,Column:CARDINAL;
  69.         Element:ComponentType;
  70. BEGIN
  71.   Column:=0;
  72.   FOR Count:=0 TO High(row) DO
  73.     Read(row,Count,Element);
  74.     WriteElement(Element);
  75.     INC(Column);
  76.     IF Column=ColumnsPerLine THEN
  77.       WriteLn;
  78.       Column:=0;
  79.     END;
  80.   END;
  81.   WriteLn;
  82. END WriteRow;
  83.  
  84. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  85. (* Heap Sort                                                            *)
  86. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  87. PROCEDURE SortRow(row:Row);
  88. VAR     re,li:CARDINAL;
  89.         x,y,z:ComponentType;
  90.  
  91.   PROCEDURE Less(x,y:ComponentType):BOOLEAN;
  92.   BEGIN
  93.     RETURN x<y;
  94.   END Less;
  95.  
  96.   PROCEDURE sift;
  97.   VAR   i,j:CARDINAL;
  98.         exit:BOOLEAN;
  99.   BEGIN
  100.     i:=li;
  101.     j:=2*i;
  102.     Read(row,i,x); (* x:=row[i] *)
  103.     exit:=FALSE;
  104.     WHILE (j<=re)AND NOT exit DO
  105.       IF j<re THEN
  106.         Read(row,j,y);     (* y:=row[j] *)
  107.         Read(row,j+1,z);   (* z:=row[j+1] *)
  108.         IF Less(y,z) THEN  (* IF y<z *)
  109.           INC(j);          (* j+1 *)
  110.         END;
  111.       END;
  112.       Read(row,j,y);       (* y:=row[j] *)
  113.       exit:=NOT Less(x,y); (* x>=row[j] *)
  114.       IF NOT exit THEN
  115.         Write(row,i,y);    (* row[i]:=row[j] *)
  116.         i:=j;
  117.         j:=2*i;
  118.       END;
  119.     END;
  120.     Write(row,i,x); (* row[i]:=x *)
  121.   END sift;
  122.  
  123. BEGIN
  124.   re:=High(row);
  125.   li:=(re DIV 2)+1;
  126.   WHILE li>1 DO
  127.     DEC(li);
  128.     sift;
  129.   END;
  130.   WHILE re>1 DO
  131.     Read(row,li,x);  (* x:=row[li] *)
  132.     Read(row,re,y);
  133.     Write(row,li,y); (* row[li]:=row[re] *)
  134.     Write(row,re,x); (* row[re]:=x *)
  135.     DEC(re);
  136.     sift;
  137.   END;
  138. END SortRow;
  139.  
  140. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  141. (* main loop                                                            *)
  142. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  143. BEGIN
  144.   InitMemSystem;
  145.   DateStamp(ADR(date));
  146.   PutSeed(date.tick);
  147.   WriteString("Rows test module: 3 passes");
  148.   WriteLn;
  149.   FOR Pass:=1 TO 3 DO
  150.     WriteString("Pass ");WriteCard(Pass,1);
  151.     WriteLn;
  152.     numbers:=RND(1000)+500;
  153.     Assert(Dim(row,numbers,SIZE(ComponentType)),ADR("Dim() failed"));
  154.     WriteString("Row with ");
  155.     WriteCard(numbers,1);
  156.     WriteString(" elements created...");
  157.     WriteLn;
  158.     FillRow(row);
  159.     WriteString("... filled with random numbers:");
  160.     WriteLn;
  161.     WriteRow(row);
  162.     WriteString("... sorting...");
  163.     WriteLn;
  164.     SortRow(row);
  165.     WriteRow(row);
  166.     WriteString("discarding Row...");
  167.     WriteLn;
  168.     Discard(row);
  169.     WriteString("pass completed.");
  170.     WriteLn;WriteLn;
  171.   END;
  172. END RowDemo.
  173.  
  174.